!***********************************************************************
!                                                                      *
      SUBROUTINE SETQIC
!                                                                      *
!   This  subroutine sets up the coefficients for SUBROUTINEs DPBDT,   *
!   QUAD, RINTI, START, YZK, ZKF.                                      *
!                                                                      *
!   No SUBROUTINES called.                                             *
!                                                                      *
!   Written by Farid A Parpia, at Oxford    Last update: 05 Oct 1992   *
!                                                                      *
!***********************************************************************
!...Translated by Pacific-Sierra Research 77to90  4.3E  10:50:39   2/14/04
!...Modified by Charlotte Froese Fischer
!                     Gediminas Gaigalas  10/05/17
!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE vast_kind_param, ONLY:  DOUBLE
      USE CNC_C
      USE GRID_C
      USE LIC13_C, A13=>A
      USE NCC_C
      USE SBC_C
      IMPLICIT NONE
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
      INTEGER :: I, J
      REAL(DOUBLE), DIMENSION(13,13) :: B13
      REAL(DOUBLE), DIMENSION(6) :: CG
      REAL(DOUBLE), DIMENSION(5,2:5) :: C5NUM
      REAL(DOUBLE), DIMENSION(6,2:6) :: C6NUM
      REAL(DOUBLE) :: B13DEN, DENOM, C5DEN, C6DEN, FACTOR
      LOGICAL :: FIRST
!-----------------------------------------------
!
!
!
!----------------------------------------------------------------------*
!                                                                      *
!   Thirteen-point  Lagrange  interpolation  coefficients for first    *
!   derivative                                                         *
!
      DATA (B13(1,I),I=1,13)/ -1486442880.0D00, 5748019200.0D00, &
         -15807052800.0D00, 35126784000.0D00, -59276448000.0D00, &
         75873853440.0D00, -73766246400.0D00, 54195609600.0D00, &
         -29638224000.0D00, 11708928000.0D00, -3161410560.0D00, 522547200.0D00&
         ,  - 39916800.0D00/
      DATA (B13(2,I),I=1,13)/ -39916800.0D00, -967524480.0D00, 2634508800.0D00&
         , -4390848000.0D00, 6586272000.0D00, -7903526400.0D00, 7376624640.0D00&
         , -5269017600.0D00, 2822688000.0D00, -1097712000.0D00, 292723200.0D00&
         , -47900160.0D00, 3628800.0D00/
      DATA (B13(3,I),I=1,13)/ 3628800.0D00, -87091200.0D00, -684478080.0D00, &
         1596672000.0D00, -1796256000.0D00, 1916006400.0D00, -1676505600.0D00, &
         1149603840.0D00, -598752000.0D00, 228096000.0D00, -59875200.0D00, &
         9676800.0D00,  - 725760.0D00/
      DATA (B13(4,I),I=1,13)/ -725760.0D00, 13063680.0D00, -143700480.0D00, &
         -476910720.0D00, 1077753600.0D00, -862202880.0D00, 670602240.0D00, &
         -431101440.0D00, 215550720.0D00, -79833600.0D00, 20528640.0D00, &
         -3265920.0D00, 241920.0D00/
      DATA (B13(5,I),I=1,13)/ 241920.0D00, -3870720.0D00, 31933440.0D00, &
         -212889600.0D00, -303937920.0D00, 766402560.0D00, -447068160.0D00, &
         255467520.0D00, -119750400.0D00, 42577920.0D00, -10644480.0D00, &
         1658880.0D00,  - 120960.0D00/
      DATA (B13(6,I),I=1,13)/ -120960.0D00, 1814400.0D00, -13305600.0D00, &
         66528000.0D00, -299376000.0D00, -148262400.0D00, 558835200.0D00, &
         -239500800.0D00, 99792000.0D00, -33264000.0D00, 7983360.0D00, &
         -1209600.0D00, 86400.0D00/
      DATA (B13(7,I),I=1,13)/ 86400.0D00, -1244160.0D00, 8553600.0D00, &
         -38016000.0D00, 128304000.0D00, -410572800.0D00, 0.0D00, &
         410572800.0D00, -128304000.0D00, 38016000.0D00, -8553600.0D00, &
         1244160.0D00,  - 86400.0D00/
      DATA (B13(8,I),I=1,13)/ -86400.0D00, 1209600.0D00, -7983360.0D00, &
         33264000.0D00, -99792000.0D00, 239500800.0D00, -558835200.0D00, &
         148262400.0D00, 299376000.0D00, -66528000.0D00, 13305600.0D00, &
         -1814400.0D00, 120960.0D00/
      DATA (B13(9,I),I=1,13)/ 120960.0D00, -1658880.0D00, 10644480.0D00, &
         -42577920.0D00, 119750400.0D00, -255467520.0D00, 447068160.0D00, &
         -766402560.0D00, 303937920.0D00, 212889600.0D00, -31933440.0D00, &
         3870720.0D00,  - 241920.0D00/
      DATA (B13(10,I),I=1,13)/ -241920.0D00, 3265920.0D00, -20528640.0D00, &
         79833600.0D00, -215550720.0D00, 431101440.0D00, -670602240.0D00, &
         862202880.0D00, -1077753600.0D00, 476910720.0D00, 143700480.0D00, &
         -13063680.0D00, 725760.0D00/
      DATA (B13(11,I),I=1,13)/ 725760.0D00, -9676800.0D00, 59875200.0D00, &
         -228096000.0D00, 598752000.0D00, -1149603840.0D00, 1676505600.0D00, &
         -1916006400.0D00, 1796256000.0D00, -1596672000.0D00, 684478080.0D00, &
         87091200.0D00,  - 3628800.0D00/
      DATA (B13(12,I),I=1,13)/ -3628800.0D00, 47900160.0D00, -292723200.0D00, &
         1097712000.0D00, -2822688000.0D00, 5269017600.0D00, -7376624640.0D00, &
         7903526400.0D00, -6586272000.0D00, 4390848000.0D00, -2634508800.0D00, &
         967524480.0D00, 39916800.0D00/
      DATA (B13(13,I),I=1,13)/ 39916800.0D00, -522547200.0D00, 3161410560.0D00&
         , -11708928000.0D00, 29638224000.0D00, -54195609600.0D00, &
         73766246400.0D00, -75873853440.0D00, 59276448000.0D00, &
         -35126784000.0D00, 15807052800.0D00, -5748019200.0D00, 1486442880.0D00&
         /
!
      DATA B13DEN/ 479001600.0D00/
!
!----------------------------------------------------------------------*
!                                                                      *
!   Coefficients for Sienkiewicz-Baylis formula                        *
!
      DATA CG/ 1771.0D00, 9235.0D00, 5890.0D00, 4610.0D00, 35.0D00, 59.0D00/
!
      DATA DENOM/ 5760.0D00/
!
!----------------------------------------------------------------------*
!                                                                      *
!   Five-point Newton-Cotes coefficients for closed integration. Ex-   *
!   pressed as rational numbers                                        *
!
      DATA (C5NUM(I,2),I=1,5)/ 251.0D00, 646.0D00, -264.0D00, 106.0D00,  - &
         19.0D00/
      DATA (C5NUM(I,3),I=1,5)/ 232.0D00, 992.0D00, 192.0D00, 32.0D00,  - 8.0D00&
         /
      DATA (C5NUM(I,4),I=1,5)/ 243.0D00, 918.0D00, 648.0D00, 378.0D00,  - &
         27.0D00/
      DATA (C5NUM(I,5),I=1,5)/ 224.0D00, 1024.0D00, 384.0D00, 1024.0D00, &
         224.0D00/
!
      DATA C5DEN/ 720.0D00/
!
!----------------------------------------------------------------------*
!                                                                      *
!   Six-point Newton-Cotes coefficients for closed integration.  Ex-   *
!   pressed as rational numbers                                        *
!
      DATA (C6NUM(I,2),I=1,6)/ 475.0D00, 1427.0D00, -798.0D00, 482.0D00, &
         -173.0D00, 27.0D00/
      DATA (C6NUM(I,3),I=1,6)/ 448.0D00, 2064.0D00, 224.0D00, 224.0D00, &
         -96.0D00, 16.0D00/
      DATA (C6NUM(I,4),I=1,6)/ 459.0D00, 1971.0D00, 1026.0D00, 1026.0D00, &
         -189.0D00, 27.0D00/
      DATA (C6NUM(I,5),I=1,6)/ 448.0D00, 2048.0D00, 768.0D00, 2048.0D00, &
         448.0D00, 0.0D00/
      DATA (C6NUM(I,6),I=1,6)/ 475.0D00, 1875.0D00, 1250.0D00, 1250.0D00, &
         1875.0D00, 475.0D00/
!
      DATA C6DEN/ 1440.0D00/
!
!----------------------------------------------------------------------*
!
      DATA FIRST/ .TRUE./
!
!   Lagrange interpolation coefficients
!
!   Do this initialization once per run only
!   Do this initialization once per run only
!
      IF (FIRST) THEN
!
!   Thirteen-point coefficients for DPBDT
!
         FACTOR = 1.0D00/B13DEN
         DO 2 J = 1,13
            DO 1 I = 1,13
               A13(I,J) = B13(I,J)*FACTOR
    1       CONTINUE
    2    CONTINUE
!
         FIRST = .FALSE.
!
      ENDIF
!
!   Sienkiewicz-Baylis coefficients for SBSTEP
!
      C(1) = CG(1)/DENOM
      FACTOR = H/DENOM
      DO 3 I = 2,6
         C(I) = CG(I)*FACTOR
    3 CONTINUE
!
!   Newton-Cotes coefficients for YZK and QUAD
!
      FACTOR = H/C5DEN
      DO 5 J = 2,4
         DO 4 I = 2,5
            CNC5C(I,J) = FACTOR*C5NUM(I,J)
    4    CONTINUE
    5 CONTINUE
!
      C1 = FACTOR*C5NUM(1,5)
      C2 = FACTOR*C5NUM(2,5)
      C3 = FACTOR*C5NUM(3,5)
      C4 = C1+C1
!
!   Newton-Cotes coefficients for START
!
      FACTOR = H/C6DEN
      DO 7 J = 2,6
         DO 6 I = 1,6
            CNC6C(I,J) = FACTOR*C6NUM(I,J)
    6    CONTINUE
    7 CONTINUE
!
!
      RETURN
!
      END SUBROUTINE SETQIC
